home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / n_b_v203.zip / STR-MATH.UNT < prev    next >
Text File  |  1996-07-04  |  25KB  |  436 lines
  1. $if 0
  2.     ┌──────────────────────────╖                        PowerBASIC v3.20
  3.  ┌──┤          DASoft          ╟──────────────────────┬──────────────────╖
  4.  │  ├──────────────────────────╢    Copyright 1995    │ DATE: 1996-01-01 ╟─╖
  5.  │  │ FILE NAME   STR-MATH.UNT ║          by          ╘════════════════─ ║ ║
  6.  │  │ LIBRARY     DAS-NB03.PBL ║  Don Schullian, Jr.                     ║ ║
  7.  │  ╘══════════════════════════╝                                         ║ ║
  8.  │ A license is hereby granted to the holder to use this source code in  ║ ║
  9.  │ any program, commercial or otherwise,  without receiving the express  ║ ║
  10.  │ permission of the copyright holder and without paying any royalties,  ║ ║
  11.  │ as long as this code is not distributed in any compilable format.     ║ ║
  12.  │  IE: source code files, PowerBASIC Unit files, and printed listings   ║ ║
  13.  ╘═╤═════════════════════════════════════════════════════════════════════╝ ║
  14.    │                .....................................                  ║
  15.    ╘═══════════════════════════════════════════════════════════════════════╝
  16. $endif
  17.  
  18. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  19. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  20. $if 1
  21.   $CODE SEG "DAS_NB03"
  22.   $EVENT               OFF
  23.   $ERROR     ALL       OFF
  24.   $OPTIMIZE  SPEED
  25.   $OPTION    GOSUB     OFF
  26.   $OPTION    CNTLBREAK OFF
  27.   $OPTION    SIGNED    OFF
  28.   $DEBUG     MAP       OFF
  29.   $DEBUG     PATH      OFF
  30.   $DEBUG     UNIT      OFF
  31.   $COMPILE   UNIT
  32. $endif
  33.  
  34. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  35. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  36. ' PURPOSE: provide extended arithmetic functions for strings
  37. '  PARAMS: N1$    N1$ + N2$  or  N1$ - N2$  or N1$ * N2$ or N1$ / N2$
  38. '          N2$    incoming numbers may be signed or not and pbvUsingChrs
  39. '                 is used to determine which (if any) decimal point is used
  40. '          Decs%  for DIVIDE only - the number of places past the decimal
  41. '                                   that are to be used in the answer
  42. ' RETURNS: the answer
  43. '          all values other than ZERO are signed with either + or -
  44. '          if the return value is ZERO then only a single "0" is returned
  45. '    NOTE: division by ZERO returns ZERO and not an error
  46. '    NOTE: N1$ * ".5" is faster than N1$ / "2"
  47. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  48. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  49.  
  50. %F   =  0  ' first pointer
  51. %L   =  1  ' last
  52. %W   =  2  ' working
  53. %Pos = 43  ' plus sign
  54. %Neg = 45  ' minus sign
  55.  
  56. DIM sN(2)      AS SHARED STRING    ' working strings
  57. DIM sD(2,2)    AS SHARED INTEGER   ' sD%(0,X%)    = places before decimal
  58.                                    ' sD%(1,X%)    = places past the decimal
  59.                                    ' sD%(2,X%)    = sign
  60. DIM N_ptr(2,2) AS SHARED BYTE PTR  ' N_ptr(%F,X%) = first digit
  61.                                    ' N_ptr(%L,X%) = last digit
  62.                                    ' N_ptr(%W,X%) = working digit
  63. SHARED sD$, sA$, sZ$, sP$          ' dec$, ascii$, chr$(0), "."
  64.  
  65. ' ──────────────────────────────────────────────────────────────────────────
  66.  
  67. FUNCTION fDIVnbr$( SEG N1$, SEG N2$, BYVAL Decs% ) LOCAL PUBLIC
  68.   LOCAL C%, L%, P%, X%
  69.  
  70.   Format_NBRs N1$, N2$, ( 4 + Decs% )              ' get everybody ready
  71.   IF N_ptr(%F,0) = 0 THEN                          ' N1=0 or N2=0
  72.     FUNCTION = "0"                                 '  function = 0
  73.     EXIT FUNCTION                                  '  RETURN
  74.   END IF                                           '
  75.                                                    '
  76.   L% = LEN( sN$(2) )                               ' length of divisor
  77.   IF sN$(1) < sN$(2) THEN INCR N_ptr(%F,0)         ' if number > divisor
  78.                                                    '
  79.   WHILE N_ptr(%F,0) =< N_ptr(%L,0)                 ' while still calculating
  80.     P% = L%                                        ' P% = # of digits to use
  81.     IF sN$(1) < sN$(2) THEN INCR P%                ' number is > divisor
  82.     IF @N_ptr(%F,0) = 46 THEN INCR N_ptr(%F,0)     ' skip the decimal point
  83.     WHILE ( sN$(1) => sN$(2) ) OR ( P% > L% )      ' while N° > divisor
  84.       N_ptr(%W,1) = N_ptr(%F,1) + P%               ' working pointers
  85.       N_ptr(%W,2) = N_ptr(%L,2) + 1                '
  86.       FOR X% = L% TO 1 STEP -1                     ' do subtraction
  87.         DECR N_ptr(%W,1)                           '  decr pointers
  88.         DECR N_ptr(%W,2)                           '
  89.         IF ( C% > 0 ) THEN                         '  if carrying
  90.           IF @N_ptr(%W,1) > 0 THEN                 '   if digit > 0
  91.               DECR @N_ptr(%W,1)                    '    subtract carry amt
  92.               C% = 0                               '    clear carry
  93.             ELSE                                   '   else
  94.               @N_ptr(%W,1) = 9                     '    carring a 9
  95.           END IF                                   '
  96.         END IF                                     '
  97.         IF @N_ptr(%W,2) > @N_ptr(%W,1) THEN        '  if digit 1 > digit 2
  98.           C% = 10                                  '   carry 10
  99.           INCR @N_ptr(%W,1), C%                    '   bump digit 1
  100.         END IF                                     '
  101.         DECR @N_ptr(%W,1), @N_ptr(%W,2)            '  subtract d2 from d1
  102.       NEXT                                         ' NEXT digit left
  103.       IF C% > 0 THEN                               ' if still carrying
  104.         DECR N_ptr(%W,1)                           '  prev digit
  105.         DECR @N_ptr(%W,1)                          '  decr ditit
  106.         C% = 0                                     '  clear carry
  107.       END IF                                       '
  108.       IF (P% > L%) AND (ASCII( sN$(1) ) = 0) THEN  ' check if right digit
  109.         P% = L%                                    ' needs to fall off
  110.         MID$(sN$(1),1) = MID$( sN$(1),2) + sZ$     ' shift left
  111.       END IF                                       '
  112.       INCR @N_ptr(%F,0)                            ' next digit in answer
  113.     WEND                                           '
  114.                                                    '
  115.     N_ptr(%W,1) = N_ptr(%L,1)                      ' check to see if number
  116.     FOR X% = LEN( sN$(1) ) TO 1 STEP -1            ' is now all ZERO's or
  117.       IF @N_ptr(%W,1) > 0 THEN EXIT FOR            ' not
  118.       DECR N_ptr(%W,1)                             '
  119.     NEXT                                           '
  120.     IF X% = 0 THEN EXIT LOOP                       ' Nope! - all done!
  121.                                                    '
  122.     WHILE ASCII( sN$(1) ) = 0                      ' if leading char ZERO
  123.       MID$( sN$(1), 1 ) = MID$(sN$(1),2) + sZ$     ' shift left
  124.       IF sN$(1) < sN$(2) THEN                      ' if number < divisor
  125.         INCR N_ptr(%F,0)                           '  skip digit in answer
  126.         IF @N_ptr(%F,0)=46 THEN INCR N_ptr(%F,0)   '  skip decimal point
  127.       END IF                                       '
  128.     WEND                                           '
  129.     INCR N_ptr(%F,0)                               ' next digit in answer
  130.   WEND                                             '
  131.                                                    '
  132.   @N_ptr(%L,0) = 0                                 '
  133.                                                    '
  134.   FUNCTION = fFormat_NBR$                          ' clean-up & bail out!
  135.  
  136. END FUNCTION
  137.  
  138. ' ──────────────────────────────────────────────────────────────────────────
  139.  
  140. FUNCTION fMULnbr$( SEG N1$, SEG N2$ ) LOCAL PUBLIC
  141.   LOCAL C%, D%, N1%, N2%, X%, Y%
  142.  
  143.   Format_NBRs N1$, N2$, 3                          ' get everybody ready
  144.   IF N_ptr(%F,0) = 0 THEN                          ' N1=0 or N2=0
  145.     FUNCTION = "0"                                 '  function = 0
  146.     EXIT FUNCTION                                  '  RETURN
  147.   END IF                                           '
  148.   N1% = LEN( sN$